perm filename HX.F4[NEW,LCS] blob sn#502578 filedate 1980-03-29 generic text, type T, neo UTF8
36600	 	SUBROUTINE RREAD(I,V)
36700	C TAKES ASCII INPUT (INP) STRING, SEPARATES LETTERS FROM NUMBERS.
36800	C MAKES ALL NUMBS FLTING PT.  FILLS UP END OF ARRAY WITH ZEROS.
36900	C SENDS BACK IN V ARRAY. 
37000	C E.G. 'GET FOO 4.55'  SENDS BACK V1=0, V2=0, V3=4.55, V4=0, ETC.
37100	 	DIMENSION I(1),V(1)
37200	 	EQUIVALENCE (N,RN)
37300	 	DO 62 J=1,22
37400	C ZERO V AND IV ARRAYS.  (COULD BE 30 ABOVE.)
37500	 62	V(J)=0
37600	 	DO 6  LEND=71,1,-1
37700	 6	IF(I(LEND).NE.' ')GO TO 7
37800	C LEND=END OF CHARS.	STARTS WITH NEXT-TO-LAST (LAST IS *)
37900	 	RETURN 
38000	 7	M=1
38100	 	J=1
38200	 8	N=I(J)
38300	 	CALL LO2UP(N)
38400	 	IF(N.EQ.' ')GO TO 16
38500	C 	IF(N.NE.'-'.AND.
38600	C 	1 N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
38610	 	IF( N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
38700	C NOW IT'S A NUMBER
38800	 20	CALL NUMZ(KK,I(J),V(M))
38900	 	J=J+KK-1
39000	 10	M=M+1
39100	 16	J=J+1
39200	 	IF(J.LE.LEND)GO TO 8 
39300	 	END
39400	 
39500	 	SUBROUTINE NUMZ(KK,I,X)
39600	 	DIMENSION I(1)
39700	 	DATA IZERO/'0'/,ININE/'9'/
39800	 	J=-1
39900	 	M=0
40000	 	XMINUS=1.
40050		IF(I(0).EQ.'-')XMINUS=-XMINUS
40075	C  I(0) MIGHT NOT WORK WITH SOME FORTRANS!!
40100	 	DO 21 KK=1,15
40200	C IS 15 ENOUGH?  YES, WILL DO ONLY 8 DIGITS PLUS DECI.PT.
40300	 	IX=I(KK)
40400	 	IF(IX.GE.IZERO.AND.IX.LE.ININE)GO TO 22
40500	C 	IF(IX.EQ.'-')GO TO 24
40600	 	IF(IX.NE.'.')GO TO 20
40700	 	J=KK
40800	 	GO TO 21
40900	C  24	XMINUS=-XMINUS
41000	C 	GO TO 21
41100	 22	N=(IX-IZERO)/536870912
41200	 	M=N+M*10
41300	 21	CONTINUE
41400	 20	IF(J.LT.0)GO TO 23
41500	 	X=KK-J-1
41600	 	X=XMINUS*M/(10.**X)
41700	 	RETURN
41800	 23	X=XMINUS*M
41900	C FOR NO DECI.
42000	 	END
42100	 
42200	 	SUBROUTINE NUMLTR(L,J)
42300	C THIS, AND ABOVE ROUTINES, TAKES CARE OF STANFORD 'REREAD' FEATURE
42400	C 'RREAD' IS CALLED JUST AFTER ORIGINAL READ STATEMENT
42500	 	COMMON R2,JA,CEN,J2,RJQ(20)  /SCM/V(22)
42600	 	J=V(1)
42700	 	N=L+1
42800	 	R2=V(N)
42900	 	DO 1 K=1,20
43000	 1	RJQ(K)=V(K+N)
43100	 	END